
'--------------------------------------------------
' Examples before Hands-On 20-1
' Statements to be entered in the Immediate Window
'--------------------------------------------------

ActiveCell.NumberFormat = "00.00"
?Columns(3).NumberFormat
Range(D1).Select
Selection.NumberFormat = "#,##0"
Range(E1).Select
Selection.NumberFormat = "$#,##0.00"
Range(A1:A4).NumberFormat = "#,##0;[red](#,#0);""zero"";@"
Selection.NumberFormat = ;;;

' Example procedures

Sub FormatUsedRange()
    ActiveSheet.UsedRange.Select
    Selection.SpecialCells(xlCellTypeConstants, 1).Select
    Selection.NumberFormat = "[<150][Red];[>250][Green];[Yellow]"
End Sub

Sub FormatVariable()
  Dim myResult, frmResult
  myResult = "1435.60"
  frmResult = Format(myResult, "Currency")
  Debug.Print frmResult
 ActiveSheet.Range("G1").FormulaR1C1 = frmResult
End Sub

' Statements to be entered in the Immediate Window

MsgBox Application.WorksheetFunction.IsNumber(ActiveCell.Value)
Selection.NumberFormat = @
MsgBox Application.WorksheetFunction.IsText(ActiveCell.Value)
Range("K3").value = UCase(ActiveCell.Value)
ActiveCell.Value = Application.WorksheetFunction.Proper(ActiveCell.Value)
ActiveCell.Value = Replace(ActiveCell.Value, " ", "_")
ActiveCell.value = RTrim(ActiveCell.value)
Selection.Font.Name = Verdana
ActiveCell.Characters(1,1).Font.ColorIndex = 3
Range(A1).NumberFormat = mm/dd/yyyy

' example procedure

Sub FormatDateFields()
   Dim wks As Worksheet
   Dim cell As Range
   Set wks = ActiveWorkbook.ActiveSheet
   For Each cell In wks.UsedRange
    If cell.NumberFormat = "mm:ss.0" Then
      cell.NumberFormat = "m/dd/yyyy h:mm:ss AM/PM"
    End If
   Next
End Sub


' Statements to be entered in the Immediate Window
Rows(7).HorizontalAlignment = xlRight


Columns("D").NumberFormat = "mm/dd/yyyy"
Columns("G").NumberFormat = "$###,##0.00"
Columns(G).Style = Currency
Columns(2).ColumnWidth = 21.5
Rows(2).RowHeight = 55.55
Columns(2).AutoFit
Rows(2).Autofit
Rows(1).Font.Bold = True
Rows(1).HorizontalAlignment = xlRight
Columns(B).HorizontalAlignment = xlCenter
Columns(ActiveCell.Column).interior.color = vbYellow
MsgBox Columns(ActiveCell.Column).ColumnWidth
ActiveSheet.Cells.EntireRow.AutoFit
ActiveSheet.Cells.EntireColumn.AutoFit

ActiveSheet.PageSetup.LeftHeader = "&BYour Company Name" & Chr(13) & "&IYour Company Department"
ActiveSheet.PageSetup.RightFooter = "Created on: " & ActiveWorkbook.BuiltinDocumentProperties("Creation Date")
ActiveSheet.PageSetup.CenterHeader = ActiveSheet.Cells(2,2).value
ActiveSheet.PageSetup.CenterFooter = ActiveWorkbook.FullName
ActiveSheet.PageSetup.CenterHeader = "&""ArialNarrow""&IYour text goes here &I&B&KFF0000now."
ActiveSheet.PageSetup.CenterHeader = ""

ActiveSheet.PageSetup.RightFooter = Format(Date, mm-dd-yyyy)


' Example procedures

Sub ApplyCellFormat()
    With ActiveSheet.Range("A1").Font
      .Name = "Tahoma"
      .FontStyle = "italic"
      .Size = 14
      .Underline = xlUnderlineStyleDouble
      .ColorIndex = 3
    End With
End Sub

Sub ColorLoop()
    Dim r As Integer
    Dim c As Integer
    Dim k As Integer
    
    k = 0
    For r = 1 To 8
        For c = 1 To 7
            Cells(r, c).Select
            k = k + 1
            ActiveCell.Value = k
            With Selection.Interior
                .ColorIndex = k
                .Pattern = xlSolid
            End With
        Next c
    Next r
End Sub


' Statements to be entered in the Immediate Window

Selection.Interior.Color = vbBlue
Selection.Interior.ColorIndex = 5
Selection.Font.Color = vbMagenta
Selection.BorderAround Weight:=xlMedium, ColorIndex:=3
Selection.BorderAround Weight:=xlThin, Color:=vbBlack
Selection.BorderAround LineStyle:=xlDashDotDot, Color:=vbBlack
ActiveSheet.Range("A1:C1").Borders(xlEdgeBottom).Weight = xlThick
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlTop

' Example procedures

Sub FormatQtrText()
    With ActiveSheet.UsedRange
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlTextString, String:="Qtr", _
            TextOperator:=xlContains
        .FormatConditions(1).Interior.Color = RGB(123, 130, 0)
    End With
End Sub



Sub HighlightAltRows()
    With ActiveSheet.UsedRange
        .FormatConditions.Add Type:=xlExpression, _
            Formula1:="=MOD(ROW(),2)=0"
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
End Sub

'Code in Table 20-4
-----------------------------------------------------
With Selection
  .FormatConditions.Delete
  .FormatConditions.AddAboveAverage
  .FormatConditions(1).AboveBelow = xlAboveAverage
.FormatConditions(1).Font.Bold = True
End With

-----------------------------------------------------
With Selection
  .FormatConditions.Add Type:=xlBlanksCondition
End With
-----------------------------------------------------

With Selection
  .FormatConditions.Add Type:=xlCellValue,
    Operator:=xlLess
    Formula1:==2000
   .FormatConditions(1).NumberFormat = #, ##0
End With
-----------------------------------------------------

If Selection.FormatConditions(1).Type = 3 Then
  MsgBox "This selection is formatted with " & _
  "ColorScale conditional format."
End If

-----------------------------------------------------

If Selection.FormatConditions(1).Type = 4 Then
  MsgBox "This selection is formatted with " & _
   "DataBar conditional format."
End If

-----------------------------------------------------

Selection.FormatConditions.Add Type:=xlErrorsCondition
-----------------------------------------------------

Sub HighlightAltRows()
  With ActiveSheet.UsedRange
    .FormatConditions.Add Type:=xlExpression, _
     Formula1:="=MOD(ROW(),2)=0"
    .FormatConditions(1).Interior.ColorIndex = 6
  End With
End Sub

-----------------------------------------------------

If Selection.FormatConditions(1).Type = 6 Then
  MsgBox "This selection is formatted with " & _
   "IconSet conditional format."
End If

-----------------------------------------------------


Sub HighlightNonEmptyCells()
    Range("A1:B12").Select
    Selection.FormatConditions.Add _
      Type:=xlNoBlanksCondition
    With Selection.FormatConditions(1).Interior
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399945066682943
    End With
End Sub
-----------------------------------------------------

Sub HighlightCellsWithNoErrors()
    Range("F1:F7").Select
    Selection.FormatConditions.Add _
        Type:=xlNoErrorsCondition
    With Selection.FormatConditions(1).Interior
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399945066682943
    End With
End Sub


------------------------------------------------------
With ActiveSheet.UsedRange
  .FormatConditions.Add Type:=xlTextString, _
     String:="es", TextOperator:=xlContains
  .FormatConditions(1).Font.Bold = True
End With

------------------------------------------------------

With ActiveSheet.UsedRange
  .FormatConditions.Add Type:=xlTimePeriod, _
    DateOperator:=xlLastMonth
  .FormatConditions(1).Interior.ColorIndex = 6
End With

------------------------------------------------------

With Selection
  .FormatConditions.AddTop10
  .FormatConditions(1).TopBottom = xlTop10Top
  .FormatConditions(1).Value = 5
  .FormatConditions(1).Percent = False
  .FormatConditions(1).Interior.Color = RGB(255,0,0)
End With

------------------------------------------------------

With Selection
  .FormatConditions.AddUniqueValues
  .FormatConditions(1).DupeUnique = xlUnique
    Formula1:==200
End With

------------------------------------------------------




' Statements to be entered in the Immediate Window

Range(B2:B17).FormatConditions(1).Priority = 2
Range(B2:B17).FormatConditions(1).SetLastPriority
Range(B2:B17).FormatConditions.Delete
Range(B2:B17).FormatConditions(2).Delete


Range("B2:E6").FormatConditions.AddDatabar
Range("B2:E6").FormatConditions.Add Type:=xlDatabar, Operator:=xlGreaterEqual, Formula1:="200"
set mBar = Selection.FormatConditions.AddDatabar
mBar.MinPoint.Modify NewType:=xlConditionValuePercentile, NewValue:=20
mBar.MaxPoint.Modify NewType:=xlConditionValuePercentile, NewValue:=80
mBar.BarColor.ColorIndex = 7


set cScale = Selection.FormatConditions.AddColorScale(ColorScaleType:=2)
cScale.ColorScaleCriteria(1).FormatColor.Color = RGB(0, 255, 0)
cScale.ColorScaleCriteria(2).FormatColor.Color = RGB(0, 0, 255)
Selection.Font.ColorIndex = 2


'--------------------------------------------------
' Hands-On 20-1
'--------------------------------------------------

Sub IconSetRules()
    Dim iSC As IconSetCondition
    
    Columns("B:B").Select
    With Selection
        .SpecialCells(xlCellTypeConstants, 23).Select
        .FormatConditions.Delete
        .NumberFormat = "$#,##0.00"
        Set iSC = Selection.FormatConditions.AddIconSetCondition
        iSC.IconSet = ActiveWorkbook.IconSets(xl3Symbols)
    End With
End Sub

Sub IconSetRulesRevised()
    Dim iSC As IconSetCondition
    
    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeConstants, 23).Select
    With Selection
        .FormatConditions.Delete
        .AutoFilter
        .NumberFormat = "$#,##0.00"
        Set iSC = Selection.FormatConditions.AddIconSetCondition
        iSC.IconSet = ActiveWorkbook.IconSets(xl3Symbols)
        With iSC.IconCriteria(2)
            .Type = xlConditionValueNumber
            .Value = 50000
            .Operator = xlGreaterEqual
        End With
        
        With iSC.IconCriteria(3)
            .Type = xlConditionValueNumber
            .Value = 80000
            .Operator = xlGreaterEqual
        End With
       
       .AutoFilter Field:=1, Criteria1:=iSC.IconSet.Item(3), _
               Operator:=xlFilterIcon
    End With
End Sub


' macro examples following Hands-On 20-1

Sub Macro1()
    '
    ' Macro1 Macro
    '
    '
    Range("F4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
End Sub


Sub Macro1()
    '
    ' Macro1 Macro
    '
    '
    Range("F4").Select
    With Selection.Interior
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
    End With
End Sub


' Procedure examples

Sub Themes4Thru10()
    Dim tintshade As Variant
    Dim heading As Variant
    Dim cell As Range
    Dim themeC As Integer
    Dim r As Integer
    Dim c As Integer
    Dim i As Integer
    
    heading = Array("ThemeColorIndex", "Neutral", "Lighter 80%", _
             "Lighter 60%", "Lighter 40%", "Darker 25%", "Darker 50%")
    tintshade = Array(0, 0.8, 0.6, 0.4, -0.25, -0.5)
    
    i = 0
    For Each cell In Range("A1:G1")
        cell.Formula = heading(i)
        i = i + 1
    Next
    
    For r = 2 To 8
       themeC = r + 2
         For c = 1 To 7
           If c = 1 Then
             Cells(r, c).Formula = themeC
           Else
               With Cells(r, c)
                   With .Interior
                     .ThemeColor = themeC
                     .TintAndShade = tintshade(c - 2)
                   End With
               End With
           End If
       Next c
    Next r
    ActiveSheet.Columns("A:G").AutoFit
End Sub


Sub GetThemeColors()
    Dim tColorScheme As ThemeColorScheme
    Dim colorArray(10) As Variant
    Dim i As Long
    Dim r As Long
    
    Set tColorScheme = ActiveWorkbook.Theme.ThemeColorScheme
    For i = 1 To 10
      colorArray(i) = tColorScheme.Colors(i).RGB
      ActiveSheet.Cells(i, 1).Value = colorArray(i)
    Next i
    i = 0
    For r = 1 To 10
      ActiveSheet.Cells(r, 2).Interior.Color = colorArray(i + 1)
      i = i + 1
    Next r
End Sub


Sub ApplyThemeColors()
    Dim i As Integer
    
    For i = 1 To 10
       ActiveSheet.Cells(i, 3).Interior.ThemeColor = i
       ActiveSheet.Cells(i, 4).Value = i
    Next i
End Sub


Sub LoadTheme()
 	ActiveWorkbook.Theme.ThemeColorScheme.Load ("C:\Program Files\Microsoft Office\Document 	Themes 12\Theme Colors\Paper.xml")
End Sub


Sub GetThemeName()
    ' set a reference to the Microsoft XML, v.6.0 Object Library
    Dim xmlDoc As DOMDocument
    Dim xmlNode As IXMLDOMNode
    
    Set xmlDoc = New DOMDocument
    xmlDoc.async = False
    'xmlDoc.Load ("C:\Ex07_ByExample\ZipPackage\xl\theme\theme1.xml")
    xmlDoc.Load ("C:\theme1.xml")
    xmlDoc.setProperty "SelectionLanguage", "XPath"
    xmlDoc.setProperty "SelectionNamespaces", _
        "xmlns:a='http://schemas.openxmlformats.org/drawingml/2006/main'"
    
    Set xmlNode = xmlDoc.SelectSingleNode("//a:clrScheme/@name")
    
    Debug.Print "Current theme name is " & xmlNode.Text & "."
    
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
End Sub


Sub AddCanShape()
    Dim oShape As Shape
    
    Set oShape = ActiveSheet.Shapes.AddShape(msoShapeCan, 54, 0, 54, 110)
    With oShape
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent4
        .Fill.Transparency = 0.5
        .Line.Visible = msoFalse
    End With
End Sub

Sub GetStyleNames()

    Dim i As Integer

    For i = 1 To ActiveWorkbook.Styles.Count
        Debug.Print "Style " & i & ":" & _
         ActiveWorkbook.Styles(i).Name
    Next i
End Sub


Sub AddAStyle()
    Dim newStyleName As String
    Dim curStyle As Variant
    Dim i As Integer
    
    newStyleName = "SimpleFormat"
    i = 0
    
    For Each curStyle In ActiveWorkbook.Styles
        i = i + 1
        If curStyle.Name = newStyleName Then
            MsgBox "This style " & "(" & newStyleName & _
               ") already exists. " & Chr(13) & _
               "It's the " & i & " style in the Styles collection."
            Exit Sub
        End If
    Next
    
    With ActiveWorkbook.Styles.Add(newStyleName)
        .Font.Name = "Arial Narrow"
        .Font.Size = "12"
        .Borders.LineStyle = xlThin
        .NumberFormat = "$#,##0_);[Red]($#,##0)"
        .IncludeAlignment = False
    End With
End Sub


Sub AddSelectionStyle()
    Dim newStyleName As String
     
    newStyleName = "InvoiceAmount"
    ActiveWorkbook.Styles.Add Name:=newStyleName, _
                BasedOn:=ActiveCell
End Sub

























